Trabajo de fin de grado

Paquetes de R usados

knitr::opts_chunk$set(warning = FALSE, message = FALSE, engine.path=list(
  python = "C://Users//manue//anaconda3//python.exe")

) 
library(gtExtras)#para crear tablas
library(gt)
library(ggplot2)
library(stats, methods,grDevices )#para graficar
library(reticulate)#para usar python
library(modeest)#para calcular la moda
library(mnormt)# normal bidimensional
library(nortest)#test de Lilliefors

Graficador

graficador <- function(a, b, l, f) {
    x <- seq(a, b, length.out = l)
    y <- x
    z <- outer(x, y, f)
    z[z < 0] = 0
    op <- par(bg = "white")
    persp(x, y, z, theta = 30, phi = 30, expand = 0.5,
        col = "lightblue", ltheta = 120, shade = 0.75,
        zlab = f, xlab = formalArgs(args(f))[1],
        ylab = formalArgs(args(f))[2]) -> res
}

Creador de tablas

histo<-function(lst){
  m=mean(lst)
  mo=mlv(lst,method = 'shorth')
  
  q1=quantile(lst, 0.025)
  q2=quantile(lst, 0.975)
  
  hist(lst,freq=FALSE)
  abline(v =m,col = "blue",lwd = 2)
  abline(v =q1,col = "red",lwd = 2)
  abline(v =q2,col = "red",lwd = 2)
  abline(v =mo,col = "green",lwd = 2)
  return(paste(
    'El cuantil para 0.025 es ' , as.character(q1),', el cuantil para 0.975 es ',as.character(q2),', la media es ' ,as.character(m),', la moda es ' ,as.character(mo),', la desviación típica es ',as.character(sd(lst))
  ))
}

Creador de histogramas

tabla <- function(dataframe) 
  # Genera tablas con código de colores para un dataframe
  {
    gt(dataframe, rownames_to_stub = TRUE) %>%
        gt_color_rows(columns = dimnames.data.frame(dataframe)[[2]],
            palette = "ggsci::blue_material", domain = range(dataframe)) %>%
        gt_theme_nytimes()
}

Influencia del precio entre las empresas

price_function <- function(p_1, p_2, k = 400)
{
    return(1 - (exp(p_1/k)/(exp(p_1/k) + exp(p_2/k))))
}
graficador(3, 1000, 60, "price_function")

Funciones asociadas a las variables dicotómicas

dicotomic_function_ps <- function(c_ps, c_xb, l_ps = 0.8) {
  return((1 - c_ps) * (1 - c_xb) * 0.75 +
           c_ps * (1 - c_xb) * 0.9 +
           c_xb * (1 - c_ps) * 0.3 +
           c_ps * c_xb * l_ps)
}

dicotomic_function_xb <- function(c_ps, c_xb, l_xb = 0.9) {
  return((1 - c_ps) * (1 - c_xb) * 0.7 +
           c_ps * (1 - c_xb) * 0.4 +
           c_xb * (1 - c_ps) * 0.8 +
           c_ps * c_xb * l_xb)
}

Control del precio

price_control_ps <- function(p, m = 2000, c_ps, c_xb,
    l_ps = 0.8) {
    m = m * dicotomic_function_ps(c_ps, c_xb, l_ps = l_ps)
    return(0 + (p <= m) * (p>=0) *((-(p - m)/m)^2))
}
price_control_xb <- function(p, m = 2000, c_ps, c_xb,
    l_xb = 0.9) {
    m = m * dicotomic_function_xb(c_ps, c_xb, l_xb = l_xb)
    return(0 + (p <= m) * (p>=0) * (((p - m)/m)^2))
}

Esperanza del número de ventas

ventas_ps <- function(p_ps, p_xb, c_ps = 1, c_xb = 0,
    k = 400, m = 2000, l_ps = 0.8)
    {
    return(5e+07 * dicotomic_function_ps(c_ps, c_xb,
        l_ps = l_ps) * price_function(p_ps, p_xb, k) *
        price_control_ps(p_ps, m, c_ps, c_xb, l_ps = l_ps))
}
ventas_xb <- function(p_ps, p_xb, c_ps = 0, c_xb = 0,
    k = 400, m = 2000, l_xb = 0.9)
    {
    return(5e+07 * dicotomic_function_xb(c_ps, c_xb,
        l_xb = l_xb) * price_function(p_xb, p_ps, k) *
        price_control_xb(p_xb, m, c_ps, c_xb, l_xb = l_xb))
}

Esperanza del beneficio

beneficios_ps <- function(p_ps, p_xb, c_ps = 0, c_xb = 0,
    k = 400, m = 2000, l_ps = 0.8)
    {
    ventas_ps(p_ps, p_xb, c_ps = c_ps, c_xb = c_xb, k = k,
        m = m, l_ps = l_ps) * (p_ps - 100)
}

beneficios_xb <- function(p_ps, p_xb, c_ps = 0, c_xb = 0,
    k = 400, m = 2000, l_xb = 0.9)
    {
    ventas_xb(p_ps, p_xb, c_ps = c_ps, c_xb = c_xb, k = k,
        m = m, l_xb = l_xb) * (p_xb - 100)
}

graficador(1, 1000, 60, "beneficios_ps")

graficador(1, 1000, 60, "beneficios_xb")

Resolución problema Bertrand

# la siguiente función calcula el equilibrio de Nash
# del problema de Bertrand
resolucion  <- function(c_ps = 0,
                       c_xb = 0,
                       k = 400,
                       m = 2000,
                       x0 = 0,
                       y0 = 0,
                       N = 100,
                       l_ps = 0.8,
                       l_xb = 0.9,
                       eps=10^-4)
  # x0 e y0 corresponde al inicio
  # N corresponde al número de iteraciones
  # usaremos por defecto N = 100 por funcionar bien
{
  # generamos una matrix que contenga todas las iteraciones
  z = matrix(0, nrow = 2, ncol = N + 1)
  z[, 1] <- c(x0, y0)# almacenamos el punto inicial
  i = 0
  l=TRUE#criterio de parada por diverger
  aux2=TRUE #criterio de parada al converger
  # iniciamos el bucle
  while (all(i < N, aux2,l))
  {
    i = i + 1
    #almacenamos el óptimo para p_p
    aux = optim(z[1, i], function(x)
    {
      -beneficios_ps(x, z[2, i], c_ps,
                     c_xb, k, m, l_ps = l_ps)
    })$par
    #comprobamos que no sea demasiado alto
    if (aux <= (m * dicotomic_function_ps(c_ps, c_xb, l_ps = l_ps))) {
      z[1, i + 1] <- aux
    } else{
      l=FALSE
    }
    
    #almacenamos el óptimo para p_x
    
    aux = optim(z[2, i], function(y)
    {
      -beneficios_xb(z[1, i + 1], y,
                     c_ps, c_xb, k, m, l_xb = l_xb)
    })$par
    if (aux <= (m * dicotomic_function_xb(c_ps, c_xb, l_xb = l_xb))) {
      z[2, i + 1] <- aux
    } else{
      l=FALSE
    }
    aux2=dist(z[1, i + 1]-z[1, i])>eps
  }

  #nos devuelve los beneficios de cada empresa
  # y los precios de las consolas del equilibrio de Nash
  return(list(
    'beneficios' = c(
      beneficios_ps(
        p_ps = z[1,
                 i + 1],
        p_xb = z[2, i + 1],
        c_ps = c_ps,
        c_xb = c_xb,
        k,
        m,
        l_ps = l_ps
      ),
      beneficios_xb(
        p_ps = z[1, i + 1],
        p_xb = z[2, i + 1],
        c_ps = c_ps,
        c_xb = c_xb,
        k,
        m,
        l_xb = l_xb
      )
    ),
    'precios' = z[, i + 1],
    'converge' = l * i==N
  ))
}

Solución problema \(2 \times 2\)

# La siguiente función calcula la p y la q 
# de un problema 2x2
solucion2 <- function(e1,e2) {
# importamos las funciones de python
np <- import("numpy", convert = FALSE)
nash <- import("nashpy", convert = FALSE)
# creamos el juego
np1<-np$array(e1)

np2<-np$array(e2)

jg<- nash$Game(np1,np2)
#obtenemos el equilibrio 
equilibria <- jg$support_enumeration(non_degenerate = FALSE)
for (i in iterate(equilibria)){

}
#el último i contiene la estrategia mixta, si la hay
  return(list('p' = py_to_r(i)[[1]][1],
              'q' = py_to_r(i)[[2]][1]))
}

Solución problema reducido

# esta función resuelve el problema completo
# devolviendonos la solución del mismo 
solucion <- function(k = 400,
                     m = 2000,
                     l_ps = 0.8,
                     l_xb = 0.9) {
  # calculamos los diferentes ejercicios de Bertrand
  conv=TRUE
  precios1=matrix(
        nrow = 2,
        ncol = 2,
        dimnames = list(
          c("No hace crossplay", "Hace crossplay"),
          c("No hace crossplay", "Hace crossplay"))
        )
  precios2=precios1
  beneficios1=precios1
  beneficios2=precios1
  for (i in 0:1) {
    for (j in 0:1){
      r= resolucion(
        k = k,
        m = m,
        c_ps = j ,
        c_xb = i,
        l_ps = l_ps,
        l_xb = l_xb
      )
    precios1[j+1,i+1]=r$precios[1]
    precios2[j+1,i+1]=r$precios[2]
    beneficios1[j+1,i+1]=round(r$beneficios[1])
    beneficios2[j+1,i+1]=round(r$beneficios[2])
    conv=conv*r$converge  
    }}
  # usamos el programa anterior para calcular 
  # la solución del problema 2x2
  solution2x2 = solucion2(precios1, precios2)
  p = solution2x2$p
  q = solution2x2$q
  # nos devuelve la solución junto con los 
  # beneficios esperados
  return(
    list(
      'p' = p,
      'q' = q,
      'beneficiosesperados' = list(
        'ps' = cbind(p, 1 - p) %*%
          beneficios1 %*%
          c(q, 1 - q),
        'xb' = cbind(p, 1 - p) %*%
          beneficios2 %*%
          c(q, 1 - q)
      ),
      'beneficiosps' = as.data.frame(beneficios1),
      'beneficiosxb' = as.data.frame(beneficios2),
      #obtenemos los precios que pone cada jugador en cada opción
      'preciosps' = as.data.frame(precios1),
      'preciosxb' = as.data.frame(precios2),
      'converge'  = conv
    )
  )
}

Resultados del problema reducido

sol =solucion()

La solución converge

sol$converge

## [1] 1

Beneficios esperados final para cada empresa

sol$beneficiosesperados

## $ps
##            [,1]
## [1,] 3665411948
## 
## $xb
##            [,1]
## [1,] 4376168454

La \(p\), siendo \((p,1-p)\) la estrategia de Playstation

sol$p

## [1] 0

La \(q\), siendo \((q,1-q)\) la estrategia de Xbox

sol$q

## [1] 0

Equilibrio de Nash de los precios para Playstation

sol$preciosps

##                   No hace crossplay Hace crossplay
## No hace crossplay          420.3572       249.2645
## Hace crossplay             440.2721       439.8871

Equilibrio de Nash de los precios para Xbox

sol$preciosxb

##                   No hace crossplay Hace crossplay
## No hace crossplay          408.0221       413.5474
## Hace crossplay             299.0318       460.4085

Beneficios esperados de Playstation obtenidos para cada caso

sol$beneficiosps

##                   No hace crossplay Hace crossplay
## No hace crossplay        3063835537      460007800
## Hace crossplay           3605449303     3665411948

Beneficios esperados de Xbox obtenidos para cada caso

sol$beneficiosxb

##                   No hace crossplay Hace crossplay
## No hace crossplay        2747973569     2749898042
## Hace crossplay            916862215     4376168454

ANÁLISIS DE SENSIBILIDAD

Función del análisis de la incertidumbre de \(h_p(1,1)\)

sensitivity2 <- function(n,a,b)
{
  conv=TRUE
  lstps=rbeta(n,a,b)#generamos los valores
      #usamos las variables auxiliares
    psolaux = c()# almacena las p obtenidas
    qsolaux = c()# almacena las q obtenidas
    pssolaux = c()# almacena los beneficios de
    # ps obtenidos
    xbsolaux = c()# almacena los beneficios de
    # xb obtenidos
    ps2solaux = c()# almacena los precios de
    # ps obtenidos para c_ps=0 y c_xb=1
    xb2solaux = c()# almacena los precios de
    # xb obtenidos para c_ps=0 y c_xb=1
    for (l_ps in lstps)# bucle para la l_ps
        {   # obtenemos la solución
            sol = solucion(l_ps = l_ps)
            # almacenamos los datos que interesan
            psolaux = c(psolaux, round(sol$p,
                4))
            qsolaux = c(qsolaux, round(sol$q,
                4))
            pssolaux = c(pssolaux,
                round(sol$beneficiosesperados$ps,
                  4))
            xbsolaux = c(xbsolaux,
                round(sol$beneficiosesperados$xb,
                  4))
            ps2solaux = c(ps2solaux,
                round(sol$preciosps[2,
                  2], 2))
            xb2solaux = c(xb2solaux,
                round(sol$preciosxb[2,
                  2], 2))
            conv=conv*sol$converge
        }

    
    # devolvemos los diferentes dataframes
    return(list('p' = psolaux, 'q' = qsolaux,
        'beneficiosps' = pssolaux, 'beneficiosxb' = xbsolaux,
        'preciosps' = ps2solaux, 'preciosxb' = xb2solaux,
        'converge'=conv))
}

Ejecutamos el análisis de sensibilidad

set.seed(2)
n=100
a=8
b=2
lista2 = sensitivity2(n,a,b)

Converge el algoritmo

lista2$converge

## [1] 1

Media de los \(p\)

mean(lista2[["p"]])

## [1] 0

Media de los \(q\)

mean(lista2[["q"]])

## [1] 0

Histograma de los beneficios de Playstation

histo(lista2[['beneficiosps']])

## [1] "El cuantil para 0.025 es  1615273846.525 , el cuantil para 0.975 es  5198874991.925 , la media es  3802338582.66 , la moda es  4302440780.54 , la desviación típica es  1006283136.00399"

Histograma de los beneficios de Xbox

histo(lista2[['beneficiosxb']])

## [1] "El cuantil para 0.025 es  3883555405.2 , el cuantil para 0.975 es  4605210455.425 , la media es  4374980663.61 , la moda es  4482525143.96 , la desviación típica es  206616743.334366"

Histograma de los precios de Playstation

histo(lista2[['preciosps']])

## [1] "El cuantil para 0.025 es  350.83675 , el cuantil para 0.975 es  480.531 , la media es  439.4743 , la moda es  458.7956 , la desviación típica es  37.2257921408686"

Histograma de los precios de Xbox

histo(lista2[['preciosxb']])

## [1] "El cuantil para 0.025 es  447.37075 , el cuantil para 0.975 es  466.60975 , la media es  460.3759 , la moda es  463.4226 , la desviación típica es  5.48209631344607"

Función del análisis de sensibilidad de la \(k\) y la \(m\)

sensitivity <- function(lstk, lstm)
{
    #usamos las variables auxiliares 
  conv=TRUE
  psolaux = c()# almacena las p obtenidas
  qsolaux = c()# almacena las q obtenidas
  pssolaux = c()# almacena los beneficios de 
  # ps obtenidos
  xbsolaux = c()# almacena los beneficios de 
  # xb obtenidos
  ps2solaux = c()# almacena los precios de 
  # ps obtenidos para c_ps=0 y c_xb=1
  xb2solaux = c()# almacena los precios de 
  # xb obtenidos para c_ps=0 y c_xb=1
  for (i in lstm)# bucle para la m
    {
        for (j in lstk)# bucle para la k
        {   # obtenemos la solución
            sol = solucion(k = j, m = i)
            # almacenamos los datos que interesan
            psolaux = c(psolaux, round(sol$p,
                4))
            qsolaux = c(qsolaux, round(sol$q,
                4))
            pssolaux = c(pssolaux,
                round(sol$beneficiosesperados$ps,
                  4))
            xbsolaux = c(xbsolaux,
                round(sol$beneficiosesperados$xb,
                  4))
            ps2solaux = c(ps2solaux,
                round(sol$preciosps[2,
                  2], 2))
            xb2solaux = c(xb2solaux,
                round(sol$preciosxb[2,
                  2], 2))
            conv=conv*sol$converge 
        }
    }
    # transformamos los datos a dataframes
    plista = as.data.frame(matrix(psolaux,
        nrow = length(lstk), ncol = length(lstm),
        dimnames = list(paste("k=",
            lstk), paste("m=", lstm))))
    qlista = as.data.frame(matrix(qsolaux,
        nrow = length(lstk), ncol = length(lstm),
        dimnames = list(paste("k=",
            lstk), paste("m=", lstm))))
    pslista = as.data.frame(matrix(pssolaux,
        nrow = length(lstk), ncol = length(lstm),
        dimnames = list(paste("k=",
            lstk), paste("m=", lstm))))
    xblista = as.data.frame(matrix(xbsolaux,
        nrow = length(lstk), ncol = length(lstm),
        dimnames = list(paste("k=",
            lstk), paste("m=", lstm))))
    xb2lista = as.data.frame(matrix(xb2solaux,
        nrow = length(lstk), ncol = length(lstm),
        dimnames = list(paste("k=",
            lstk), paste("m=", lstm))))
    ps2lista = as.data.frame(matrix(ps2solaux,
        nrow = length(lstk), ncol = length(lstm),
        dimnames = list(paste("k=",
            lstk), paste("m=", lstm))))
    # devolvemos los diferentes dataframes
    return(list('p' = plista, 'q' = qlista,
        'beneficiosps' = pslista, 'beneficiosxb' = xblista,
        'preciosps' = ps2lista, 'preciosxb' = xb2lista,
        'converge'=conv))
}

Evaluamos la función

# creamos el mallado
lstk = seq(200, 600, length.out = 9)
lstm = seq(1000, 3000, length.out = 9)
# evaluamos el mallado 
lista = sensitivity(lstk, lstm)

Comprobamos que converge

lista$converge

## [1] 1

Obtenemos la tabla de la \(p\)

tabla(lista[["p"]])

	m= 2000	m= 2250	m= 2500	m= 2750	m= 3000
k= 200	0.8752	0.848	0.8250	0.8056	0.7898
k= 250	0.0000	0.000	0.8726	0.8519	0.8328
k= 300	0.0000	0.000	0.0000	0.0000	0.8721
k= 350	0.0000	0.000	0.0000	0.0000	0.0000
k= 400	0.0000	0.000	0.0000	0.0000	0.0000
k= 450	0.0000	0.000	0.0000	0.0000	0.0000
k= 500	0.0000	0.000	0.0000	0.0000	0.0000
k= 550	0.0000	0.000	0.0000	0.0000	0.0000
k= 600	0.0000	0.000	0.0000	0.0000	0.0000

Obtenemos la tabla de la \(q\)

tabla(lista[["q"]])

	m= 2000	m= 2250	m= 2500	m= 2750	m= 3000
k= 200	0.9928	0.977	0.9651	0.9548	0.9470
k= 250	0.0000	0.000	0.9920	0.9796	0.9689
k= 300	0.0000	0.000	0.0000	0.0000	0.9917
k= 350	0.0000	0.000	0.0000	0.0000	0.0000
k= 400	0.0000	0.000	0.0000	0.0000	0.0000
k= 450	0.0000	0.000	0.0000	0.0000	0.0000
k= 500	0.0000	0.000	0.0000	0.0000	0.0000
k= 550	0.0000	0.000	0.0000	0.0000	0.0000
k= 600	0.0000	0.000	0.0000	0.0000	0.0000

Obtenemos la tabla de los beneficios esperados de Playstation

tabla(lista[['beneficiosps']])

	m= 1000	m= 1250	m= 1500	m= 1750	m= 2000	m= 2250	m= 2500	m= 2750	m= 3000
k= 200	1507584083	1965591008	2380143772	2752750928	2652873864	2906595062	3140921257	3354637132	3551799715
k= 250	1546131330	2041127306	2501788127	2926159824	3314630443	3669686131	3444385258	3695436686	3929660465
k= 300	1568107579	2087385417	2579991822	3041689354	3472337098	3871936572	4241712304	4585411821	4236637708
k= 350	1581317042	2116865447	2631766986	3120899396	3583849435	4018537734	4426469866	4808418765	5165654640
k= 400	1589610198	2136159879	2667660319	3178076864	3665411948	4127766690	4566005972	4979761959	5370182729
k= 450	1594821540	2149494742	2692764130	3218917373	3725420728	4210351901	4672534439	5113045012	5532264982
k= 500	1598154405	2158630791	2710735907	3249232976	3770762571	4273313057	4755872762	5218676287	5660733657
k= 550	1600444871	2164962963	2724059154	3271892288	3805303363	4322349683	4820988533	5302190893	5765104296
k= 600	1601867661	2169741342	2733853579	3289212343	3832239148	4360797813	4874107560	5369454961	5849185658

Obtenemos la tabla de los beneficios esperados de Xbox

tabla(lista[['beneficiosxb']])

	m= 1000	m= 1250	m= 1500	m= 1750	m= 2000	m= 2250	m= 2500	m= 2750	m= 3000
k= 200	1839819353	2361427842	2830308934	3249545230	2194850974	2395607578	2577488075	2744601586	2898366183
k= 250	1901269854	2468318160	2991746669	3472061795	3909612095	4308629825	2858576629	3059381206	3243179154
k= 300	1941150950	2539320374	3101782734	3626632952	4112964205	4564244623	4979848153	5365708599	3527160129
k= 350	1968901134	2588896408	3179063504	3737922487	4262993529	4754425596	5215309730	5645356619	6046917677
k= 400	1989055132	2625235912	3237404138	3821430326	4376168454	4900972430	5397094732	5864128281	6304138902
k= 450	2004316972	2652984610	3281296274	3885561098	4464085862	5015532028	5540123887	6039106288	6512146528
k= 500	2016297824	2674562585	3315837431	3936115123	4533714984	5106978440	5655492205	6180745235	6681047097
k= 550	2025885318	2691853692	3343519388	3976700336	4589626178	5181138827	5749669826	6296532312	6821040583
k= 600	2033627763	2706077134	3366207940	4010024095	4635529465	5242055425	5827721737	6392924016	6938014217

Obtenemos la tabla de los precios de Playstation

tabla(lista[['preciosps']])

	m= 1000	m= 1250	m= 1500	m= 1750	m= 2000	m= 2250	m= 2500	m= 2750	m= 3000
k= 200	262.54	290.32	312.87	331.48	346.95	359.97	371.05	380.59	388.87
k= 250	274.02	306.94	334.62	358.20	378.23	395.51	410.39	423.46	434.87
k= 300	282.32	319.34	351.29	379.04	403.09	424.29	442.75	459.27	473.89
k= 350	288.62	328.83	364.15	395.57	423.31	447.84	469.87	489.49	507.09
k= 400	293.51	336.33	374.72	409.05	439.89	467.57	492.61	515.12	535.52
k= 450	297.44	342.45	383.21	420.17	453.75	484.18	511.85	537.17	560.23
k= 500	300.68	347.47	390.30	429.49	465.45	498.32	528.41	556.22	581.63
k= 550	303.40	351.69	396.29	437.39	475.37	510.47	542.75	572.72	600.44
k= 600	305.64	355.32	401.43	444.19	483.92	520.97	555.28	587.21	617.02

Obtenemos la tabla de los precios de Xbox

tabla(lista[['preciosxb']])

	m= 1000	m= 1250	m= 1500	m= 1750	m= 2000	m= 2250	m= 2500	m= 2750	m= 3000
k= 200	273.54	300.44	322.04	339.78	354.46	366.76	377.25	386.25	394.13
k= 250	287.86	320.31	347.22	369.85	389.01	405.43	419.60	431.91	442.73
k= 300	298.52	335.58	367.05	393.95	417.26	437.50	455.14	470.86	484.71
k= 350	306.74	347.59	382.89	413.54	440.64	464.39	485.49	504.27	521.04
k= 400	313.27	357.20	395.95	430.06	460.41	487.34	511.54	533.22	552.76
k= 450	318.52	365.17	406.73	443.80	477.12	507.07	533.99	558.45	580.76
k= 500	322.81	371.77	415.78	455.54	491.49	524.07	553.66	580.73	605.37
k= 550	326.50	377.29	423.56	465.59	503.91	538.93	570.82	600.27	627.40
k= 600	329.59	382.16	430.22	474.35	514.80	551.95	586.29	617.64	646.92

Función del análisis de la incertidumbre de la \(k\) y la \(m\).

sensitivity3 <- function(n=100,mu,A)
{
  conv=TRUE
lstkm=rmnorm(n,mean=mu,varcov = A )
      #usamos las variables auxiliares
    psolaux = c()# almacena las p obtenidas
    qsolaux = c()# almacena las q obtenidas
    pssolaux = c()# almacena los beneficios de
    # ps obtenidos
    xbsolaux = c()# almacena los beneficios de
    # xb obtenidos
    ps2solaux = c()# almacena los precios de
    # ps obtenidos para c_ps=0 y c_xb=1
    xb2solaux = c()# almacena los precios de
    # xb obtenidos para c_ps=0 y c_xb=1
    for (i in 1:n)# bucle para  k m
        {   # obtenemos la solución
            x=lstkm[i,]
            sol = solucion(k=x[1],m=x[2])
            # almacenamos los datos que interesan
            psolaux = c(psolaux, round(sol$p,
                4))
            qsolaux = c(qsolaux, round(sol$q,
                4))
            pssolaux = c(pssolaux,
                round(sol$beneficiosesperados$ps,
                  4))
            xbsolaux = c(xbsolaux,
                round(sol$beneficiosesperados$xb,
                  4))
            ps2solaux = c(ps2solaux,
                round(sol$preciosps[2,
                  2], 2))
            xb2solaux = c(xb2solaux,
                round(sol$preciosxb[2,
                  2], 2))
            conv=conv*sol$converge
        }

    
    # devolvemos los diferentes dataframes
    return(list('p' = psolaux, 'q' = qsolaux,
        'beneficiosps' = pssolaux, 'beneficiosxb' = xbsolaux,
        'preciosps' = ps2solaux, 'preciosxb' = xb2solaux,
        'converge'=conv))
}

Evaluamos la función

set.seed(2)
A=matrix(c(10000,10000,20000,100000),ncol = 2,nrow = 2)
mu=c(400,2000)
lista3=sensitivity3(mu = mu,A = A)

Converge el algoritmo

lista3$converge

## [1] 1

Número de \(p\ne 0\)

sum(lista3[["p"]]!=0)

## [1] 2

estrategias con \(p\ne 0\)

lista3[["p"]][lista3[["p"]]!=0]

## [1] 0.8815 0.8504

Número de \(q\ne 0\)

sum(lista3[["q"]]!=0)

## [1] 2

Estrategias con \(q\ne 0\)

lista3[["q"]][lista3[["q"]]!=0]

## [1] 0.9980 0.9773

Histograma de los beneficios de Playstation

# analizamos los beneficios de Playstation
histo(lista3[['beneficiosps']])

## [1] "El cuantil para 0.025 es  2320588561.375 , el cuantil para 0.975 es  5058816850.5 , la media es  3632064350.17378 , la moda es  3681654887.84 , la desviación típica es  748595724.380077"

Test de Lilliefors de los beneficios de Playstation

lillie.test(lista3[['beneficiosps']])

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  lista3[["beneficiosps"]]
## D = 0.056733, p-value = 0.5958

Histograma de los beneficios de Xbox

histo(lista3[['beneficiosxb']])

## [1] "El cuantil para 0.025 es  2534768133.92715 , el cuantil para 0.975 es  6001047113.9 , la media es  4320973027.6018 , la moda es  4400922840.34 , la desviación típica es  917143273.61859"

Test de Lilliefors de los beneficios de Xbox

lillie.test(lista3[['beneficiosxb']])

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  lista3[["beneficiosxb"]]
## D = 0.049456, p-value = 0.7924

Histograma de los precios de Playstation

histo(lista3[['preciosps']])

## [1] "El cuantil para 0.025 es  320.885 , el cuantil para 0.975 es  547.6075 , la media es  438.4731 , la moda es  412.4524 , la desviación típica es  64.0801629068756"

Test de Lilliefors de los precios de Playstation

lillie.test(lista3[['preciosps']])

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  lista3[["preciosps"]]
## D = 0.07638, p-value = 0.1615

Histograma de los precios de Xbox

histo(lista3[['preciosxb']])

## [1] "El cuantil para 0.025 es  332.9275 , el cuantil para 0.975 es  572.6305 , la media es  459.2708 , la moda es  427.1746 , la desviación típica es  68.77851948674"

Test de Lilliefors de los precios de Xbox

lillie.test(lista3[['preciosxb']])

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  lista3[["preciosxb"]]
## D = 0.079834, p-value = 0.1212

Trabajo de fin de grado

Manuel Grau Roldán

2023-02-15